home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / SOUND.SWG / 0019_Sonic effects.pas < prev    next >
Pascal/Delphi Source File  |  1993-06-22  |  3KB  |  117 lines
  1. UNIT Tones;
  2.  
  3. { TONES - a set of functions that provide some
  4.   interesting sonic effects.  Useful for games
  5.   or alerts.                                                                        }
  6.  
  7. INTERFACE
  8.  
  9. PROCEDURE Tone(CycleLen,NbrCycles: Integer);
  10. PROCEDURE Noise(D: Longint);
  11. PROCEDURE Chirp(F1,F2,Cycles: Integer);
  12. PROCEDURE Sound2(F: Longint);
  13. PROCEDURE NoSound2;
  14.  
  15. IMPLEMENTATION
  16.  
  17. { Tone - output a tone
  18.  
  19.   INP:        cyclen - Length (counts) for 1/2 cycle
  20.          numcyc - number of cycles to make  }
  21.  
  22. PROCEDURE Tone(CycleLen,NbrCycles: Integer);
  23.  
  24. VAR
  25.         T,I,J : Integer;
  26.  
  27. BEGIN
  28.    NbrCycles := NbrCycles SHL 1;  {# half Cycles}
  29.         T := Port[$61];                {Port contents}
  30.         FOR I := 1 TO NbrCycles DO
  31.                 BEGIN
  32.                   T := T XOR 2;
  33.                   Port[$61] := T;
  34.         FOR J :=1 TO CycleLen DO
  35.       END
  36. END;
  37.  
  38.  
  39. { Noise - make noise for a certain amount of
  40.   counts.
  41.  
  42.   INP:   D - the number of kilocounts of Noise}
  43.  
  44. PROCEDURE Noise(D: Longint);
  45. VAR
  46.         Count : Longint;
  47.         T,J,I : Integer;
  48. BEGIN
  49.         T := Port[$61];
  50.         Count := 0;
  51.         WHILE Count < D DO
  52.       BEGIN
  53.          J := (Random(32768) MOD 128) SHL 4;
  54.          FOR I := 1 TO J DO;
  55.          T := T XOR 2;
  56.                    Port[$61] := T;
  57.                         Inc(Count,J)
  58.       END
  59. END;
  60.  
  61. { Chirp - create a 'bird Chirp' TYPE Noise
  62.  
  63.   INP:F1 - # OF counts FOR the starting freq.
  64.                  F2 - # OF counts FOR the ending freq.
  65.   Cycles - # OF Cycles OF each frequency }
  66.  
  67. PROCEDURE Chirp(F1,F2,Cycles: Integer);
  68. VAR
  69.         I,J,K,L : Integer;
  70. BEGIN
  71.         L := Port[$61];
  72.         Cycles := Cycles * 2;
  73.         I := F1;
  74.         WHILE I <> F2 DO
  75.                 BEGIN
  76.                         FOR J := 1 TO Cycles DO
  77.                                 BEGIN
  78.                                         L := L XOR 2;
  79.                                         Port[$61] := L;
  80.                                         FOR K := 1 TO I DO
  81.                                 END;
  82.                         IF F1 > F2 THEN Dec(I)
  83.                         ELSE Inc(I)
  84.                 END
  85. END;
  86.  
  87. { Sound2 - Generate a continuous tone using the
  88.   internal timer.
  89.  
  90.   INP:        F - the desired frequeny }
  91.  
  92. PROCEDURE Sound2(F: Longint);
  93. VAR
  94.         C : Longint;
  95. BEGIN
  96.         IF F < 19 THEN F := 19;             {Prevent overflow}
  97.         C := 1193180 DIV F;
  98.         Port[$43] := $B6;         {Program new divisor}
  99.         Port[$42] := C MOD 256;   {Rate into the timer}
  100.         Port[$42] := C DIV 256;
  101.         C := Port[$61];         {Enable speaker output}
  102.         Port[$61] := C OR 3     {from the timer       }
  103. END;
  104.  
  105.  
  106. { NoSound2 - turn off the continuous tone               }
  107.  
  108. PROCEDURE NoSound2;
  109. VAR
  110.         C : Integer;
  111. BEGIN
  112.         C := Port[$61];             {Mask off speaker}
  113.         Port[$61] := C AND $FC      {output from timer}
  114. END;
  115.  
  116. END.
  117.